Delphi 2.0 - Programmer's Utilities Power Pack/Delphi 2.0 Programmer's Utilities Power Pack.iso/m_to_r/picdll/winstuff.pas

Pascal/Delphi Source File | 1996-09-15 | 7.2 KB | 270 lines

unit Winstuff;
{ Program copyright (c) 1995 by Charles Calvert }
{ Project Name: WINSTUFF }

{
  This unit shows four types of routines exported from a DLL:

    HandleButton: Simple MessageBox routine

    About
    ShowAbout: Launch and run a modal dialog

    RegisterWinPopup
    CreateWinPopup: Create and show a popup window

    RegisterChild
    CreateChild: Register, Create, and Show a child window
}

interface

uses
  WinTypes, WinProcs, SysUtils,
  Messages;

procedure HandleButton(Window: HWnd); export;
function About(Dialog: HWnd; Message, WParam: Word; LParam: Longint): Bool; export;
procedure ShowAbout(Window: Hwnd); export;
function RegisterChild(ParentWindow: HWnd): HWnd; export;
function CreateChild(ParentWindow: HWnd): Hwnd; export;
procedure RegisterWinPopup; export;
procedure CreateWinPopup; export;

implementation

{$R WINSTUFF.RES}

{ A trivial routine showing that it is easy to pass
  a window handle into a DLL }
procedure HandleButton(Window: HWnd);
begin
  MessageBox(Window, 'Hello', 'Sam', MB_OK);
end;

{--- The About Dialog ---}

const
  idm_About = 100;

{ This is the main routine for the About Dialog. It
  handles all messages sent to the dialog, and is responsible
  for telling it to close itself when the user clicks on the
  Ok or Cancel button. }
function About(Dialog: HWnd; Message, WParam: Word;
  LParam: Longint): Bool;
begin
  About := True;
  case Message of
    wm_InitDialog:
      Exit;
    wm_Command:
      if (WParam = id_Ok) or (WParam = id_Cancel) then begin
        EndDialog(Dialog, 1);
        Exit;
      end;
  end;
  About := False;
end;

{ Create, show, and destroy a modal dialog }
procedure ShowAbout(Window: Hwnd);
var
  AboutProc: TFarProc;
begin
  AboutProc := MakeProcInstance(@About, HInstance);
  DialogBox(HInstance, 'AboutBox', Window, AboutProc);
  FreeProcInstance(AboutProc);
end;

{ -- Popup Window -- }

const
  PopupName = 'PopStuff';

{ The WindProc for the Popup Window. }
function PopupWinProc(Window: HWnd; Message, WParam: Word; LParam: Longint): Longint; export;
const
  S:PChar = 'Hello from the DLL';
  S1:PChar = 'Try clicking left button, or right button';
var
  AboutProc: TFarProc;
  PS: TPaintStruct;
  PaintDC: HDC;

begin
  PopupWinProc := 0;
  case Message of
    wm_LButtonDown: begin
      HandleButton(Window);
      Exit;
    end;

    wm_RButtonDown: begin
      AboutProc := MakeProcInstance(@About, HInstance);
      DialogBox(HInstance, 'AboutBox', Window, AboutProc);
      FreeProcInstance(AboutProc);
      Exit;
    end;

    wm_Paint: begin
      PaintDC := BeginPaint(Window, PS);
        TextOut(PaintDC, 10, 10, S, strlen(S));
        TextOut(PaintDC, 10, 50, S1, strlen(S1));
      EndPaint(Window, PS);
    end;
  end;
  PopupWinProc := DefWindowProc(Window, Message, WParam, LParam);
end;

{ The Create routine for the Popup Window. Basically, its
  just a wrapper around the complex CreateWindow call. The
  call to ShowWindow makes the window visible, with sw_ShowNormal
  specifying that it is shown in a normal state, and not
  minimized or maximized. }

procedure CreateWinPopup;
var
  Window: Hwnd;
begin
  Window := CreateWindow(
    PopupName, 'Popup without VCL', ws_OverLappedWindow,
    cw_UseDefault, cw_UseDefault, cw_UseDefault, cw_UseDefault,
    0, 0, HInstance, nil);

  CmdShow := Sw_ShowNormal;

  ShowWindow(Window, CmdShow);
  UpdateWindow(Window);
end;

{ The Register routine for the Popup Window. The main chore
  is to fill out the complex TWndClass structure, and pass it
  to RegisterWindow. After the window has been registered,
  the call to the local CreateWinPopup routine actually creates
  it and shows it on screen. Only call RegisterWindow once
  for each window in your application.}

procedure RegisterWinPopup;
var
  Window: HWnd;
  WndClass: TWndClass;
begin
  if HPrevInst = 0 then begin
    WndClass.Style := 0;
    WndClass.lpfnWndProc := @PopupWinProc;
    WndClass.cbClsExtra := 0;
    WndClass.cbWndExtra := 0;
    WndClass.hInstance := HInstance;
    WndClass.hIcon := LoadIcon(0, idi_Application);
    WndClass.hCursor := LoadCursor(0, idc_Arrow);
    WndClass.hbrBackground := GetStockObject(white_Brush);
    WndClass.lpszMenuName := PopupName;
    WndClass.lpszClassName := PopupName;

    if not RegisterClass(WndClass) then Halt(255);
  end;

  CreateWinPopUp;
end;

{ -- Child Window -- }

const
  ChildName = 'ChildWindow';

{ This is the WindProc for the child Window.
  It paints text to the window, and handles right and
  left button clicks. }
function ChildProc(Window: HWnd; Message, WParam: Word; LParam: Longint): Longint; export;
const
  S:PChar = 'Hello from the DLL';
  S1:PChar = 'Try clicking left button, or right button';
var
  AboutProc: TFarProc;
  PS: TPaintStruct;
  PaintDC: HDC;

begin
  ChildProc := 0;

  case Message of
    wm_LButtonDown: begin
      HandleButton(Window);
      Exit;
    end;

    wm_RButtonDown: begin
      AboutProc := MakeProcInstance(@About, HInstance);
      DialogBox(HInstance, 'AboutBox', Window, AboutProc);
      FreeProcInstance(AboutProc);
      Exit;
    end;

    wm_Paint: begin
      PaintDC := BeginPaint(Window, PS);
        TextOut(PaintDC, 10, 10, S, strlen(S));
        TextOut(PaintDC, 10, 50, S1, strlen(S1));
      EndPaint(Window, PS);
      Exit;
    end;
  end;

  ChildProc := DefWindowProc(Window, Message, WParam, LParam);
end;

{ The Create routine for the Child Window. Basically, its
  just a wrapper around the complex CreateWindow call. The
  call to ShowWindow makes the window visible, with sw_ShowNormal
  specifying that it is shown in a normal state, and not
  minimized or maximized. }
function CreateChild(ParentWindow: Hwnd): Hwnd;
var
  ASimpleWindow: HWnd;
begin
  ASimpleWindow := CreateWindow(
    ChildName, 'Child without VCL',
    ws_ChildWindow or ws_Caption or ws_ClipSiblings or
    ws_visible or ws_ThickFrame or ws_SysMenu,
    1, 75, 200, 100, ParentWindow, 0, HInstance, nil);

  CmdShow := sw_ShowNormal;

  ShowWindow(ASimpleWindow, CmdShow);

  Result := ASimpleWindow;
end;

{ The Register routine for the Child Window. The main chore
  is to fill out the complex TWndClass structure, and pass it
  to RegisterWindow. After the window has been registered,
  the call to the local CreateChild routine actually creates
  it and shows it on screen. Only call RegisterWindow once
  for each window in your application.}
function RegisterChild(ParentWindow: HWnd): HWnd;
var
  Window: HWnd;
  WndClass: TWndClass;
begin
  if HPrevInst = 0 then begin
    WndClass.Style := cs_HRedraw or cs_VRedraw;
    WndClass.lpfnWndProc := @ChildProc;
    WndClass.cbClsExtra := 0;
    WndClass.cbWndExtra := 0;
    WndClass.hInstance := HInstance;
    WndClass.hIcon := LoadIcon(0, idi_Application);
    WndClass.hCursor := LoadCursor(0, idc_Arrow);
    WndClass.hbrBackground := GetStockObject(White_Brush);
    WndClass.lpszMenuName := ChildName;
    WndClass.lpszClassName := ChildName;

    if not RegisterClass(WndClass) then Halt(255);
  end;

  Result := CreateChild(ParentWindow);
end;

end.